home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2002 November / CD 1 / APC0211D1.ISO / workshop / prog / files / ActivePerl-5.6.1.633-MSWin32.msi / _cb70ba6e1c67e5bcbb02d5eb9579fac4 < prev    next >
Encoding:
Text File  |  2002-05-01  |  9.1 KB  |  370 lines
  1. # $Id: RobotRules.pm,v 1.22 2001/04/20 18:38:22 gisle Exp $
  2.  
  3. package WWW::RobotRules;
  4.  
  5. =head1 NAME
  6.  
  7. WWW::RobotsRules - Parse robots.txt files
  8.  
  9. =head1 SYNOPSIS
  10.  
  11.  require WWW::RobotRules;
  12.  my $robotsrules = new WWW::RobotRules 'MOMspider/1.0';
  13.  
  14.  use LWP::Simple qw(get);
  15.  
  16.  $url = "http://some.place/robots.txt";
  17.  my $robots_txt = get $url;
  18.  $robotsrules->parse($url, $robots_txt);
  19.  
  20.  $url = "http://some.other.place/robots.txt";
  21.  my $robots_txt = get $url;
  22.  $robotsrules->parse($url, $robots_txt);
  23.  
  24.  # Now we are able to check if a URL is valid for those servers that
  25.  # we have obtained and parsed "robots.txt" files for.
  26.  if($robotsrules->allowed($url)) {
  27.      $c = get $url;
  28.      ...
  29.  }
  30.  
  31. =head1 DESCRIPTION
  32.  
  33. This module parses a F</robots.txt> file as specified in
  34. "A Standard for Robot Exclusion", described in
  35. <http://info.webcrawler.com/mak/projects/robots/norobots.html>
  36. Webmasters can use the F</robots.txt> file to disallow conforming
  37. robots access to parts of their web site.
  38.  
  39. The parsed file is kept in the WWW::RobotRules object, and this object
  40. provides methods to check if access to a given URL is prohibited.  The
  41. same WWW::RobotRules object can parse multiple F</robots.txt> files.
  42.  
  43. The following methods are provided:
  44.  
  45. =over 4
  46.  
  47. =cut
  48.  
  49. $VERSION = sprintf("%d.%02d", q$Revision: 1.22 $ =~ /(\d+)\.(\d+)/);
  50. sub Version { $VERSION; }
  51.  
  52. use strict;
  53. use URI ();
  54.  
  55.  
  56. =item $rules = WWW::RobotRules->new($robot_name)
  57.  
  58. This is the constructor for WWW::RobotRules objects.  The first 
  59. argument given to new() is the name of the robot. 
  60.  
  61. =cut
  62.  
  63. sub new {
  64.     my($class, $ua) = @_;
  65.  
  66.     # This ugly hack is needed to ensure backwards compatability.
  67.     # The "WWW::RobotRules" class is now really abstract.
  68.     $class = "WWW::RobotRules::InCore" if $class eq "WWW::RobotRules";
  69.  
  70.     my $self = bless { }, $class;
  71.     $self->agent($ua);
  72.     $self;
  73. }
  74.  
  75.  
  76. =item $rules->parse($robot_txt_url, $content, $fresh_until)
  77.  
  78. The parse() method takes as arguments the URL that was used to
  79. retrieve the F</robots.txt> file, and the contents of the file.
  80.  
  81. =cut
  82.  
  83. sub parse {
  84.     my($self, $robot_txt_uri, $txt, $fresh_until) = @_;
  85.     $robot_txt_uri = URI->new("$robot_txt_uri");
  86.     my $netloc = $robot_txt_uri->host . ":" . $robot_txt_uri->port;
  87.  
  88.     $self->clear_rules($netloc);
  89.     $self->fresh_until($netloc, $fresh_until || (time + 365*24*3600));
  90.  
  91.     my $ua;
  92.     my $is_me = 0;        # 1 iff this record is for me
  93.     my $is_anon = 0;        # 1 iff this record is for *
  94.     my @me_disallowed = ();    # rules disallowed for me
  95.     my @anon_disallowed = ();    # rules disallowed for *
  96.  
  97.     # blank lines are significant, so turn CRLF into LF to avoid generating
  98.     # false ones
  99.     $txt =~ s/\015\012/\012/g;
  100.  
  101.     # split at \012 (LF) or \015 (CR) (Mac text files have just CR for EOL)
  102.     for(split(/[\012\015]/, $txt)) {
  103.  
  104.     # Lines containing only a comment are discarded completely, and
  105.         # therefore do not indicate a record boundary.
  106.     next if /^\s*\#/;
  107.  
  108.     s/\s*\#.*//;        # remove comments at end-of-line
  109.  
  110.     if (/^\s*$/) {        # blank line
  111.         last if $is_me; # That was our record. No need to read the rest.
  112.         $is_anon = 0;
  113.     }
  114.         elsif (/^User-Agent:\s*(.*)/i) {
  115.         $ua = $1;
  116.         $ua =~ s/\s+$//;
  117.         if ($is_me) {
  118.         # This record already had a User-agent that
  119.         # we matched, so just continue.
  120.         }
  121.         elsif ($ua eq '*') {
  122.         $is_anon = 1;
  123.         }
  124.         elsif($self->is_me($ua)) {
  125.         $is_me = 1;
  126.         }
  127.     }
  128.     elsif (/^Disallow:\s*(.*)/i) {
  129.         unless (defined $ua) {
  130.         warn "RobotRules: Disallow without preceding User-agent\n";
  131.         $is_anon = 1;  # assume that User-agent: * was intended
  132.         }
  133.         my $disallow = $1;
  134.         $disallow =~ s/\s+$//;
  135.         if (length $disallow) {
  136.         my $ignore;
  137.         eval {
  138.             my $u = URI->new_abs($disallow, $robot_txt_uri);
  139.             $ignore++ if $u->scheme ne $robot_txt_uri->scheme;
  140.             $ignore++ if lc($u->host) ne lc($robot_txt_uri->host);
  141.             $ignore++ if $u->port ne $robot_txt_uri->port;
  142.             $disallow = $u->path_query;
  143.             $disallow = "/" unless length $disallow;
  144.         };
  145.         next if $@;
  146.         next if $ignore;
  147.         }
  148.  
  149.         if ($is_me) {
  150.         push(@me_disallowed, $disallow);
  151.         }
  152.         elsif ($is_anon) {
  153.         push(@anon_disallowed, $disallow);
  154.         }
  155.     }
  156.     else {
  157.         warn "RobotRules: Unexpected line: $_\n";
  158.     }
  159.     }
  160.  
  161.     if ($is_me) {
  162.     $self->push_rules($netloc, @me_disallowed);
  163.     } else {
  164.     $self->push_rules($netloc, @anon_disallowed);
  165.     }
  166. }
  167.  
  168. # is_me()
  169. #
  170. # Returns TRUE if the given name matches the
  171. # name of this robot
  172. #
  173. sub is_me {
  174.     my($self, $ua) = @_;
  175.     my $me = $self->agent;
  176.     return index(lc($me), lc($ua)) >= 0;
  177. }
  178.  
  179. =item $rules->allowed($uri)
  180.  
  181. Returns TRUE if this robot is allowed to retrieve this URL.
  182.  
  183. =cut
  184.  
  185. sub allowed {
  186.     my($self, $uri) = @_;
  187.     $uri = URI->new("$uri");
  188.     my $netloc = $uri->host . ":" . $uri->port;
  189.  
  190.     my $fresh_until = $self->fresh_until($netloc);
  191.     return -1 if !defined($fresh_until) || $fresh_until < time;
  192.  
  193.     my $str = $uri->path_query;
  194.     my $rule;
  195.     for $rule ($self->rules($netloc)) {
  196.     return 1 unless length $rule;
  197.     return 0 if index($str, $rule) == 0;
  198.     }
  199.     return 1;
  200. }
  201.  
  202. # The following methods must be provided by the subclass.
  203. sub agent;
  204. sub visit;
  205. sub no_visits;
  206. sub last_visits;
  207. sub fresh_until;
  208. sub push_rules;
  209. sub clear_rules;
  210. sub rules;
  211. sub dump;
  212.  
  213. package WWW::RobotRules::InCore;
  214.  
  215. use vars qw(@ISA);
  216. @ISA = qw(WWW::RobotRules);
  217.  
  218. =item $rules->agent([$name])
  219.  
  220. Get/set the agent name. NOTE: Changing the agent name will clear the robots.txt
  221. rules and expire times out of the cache.
  222.  
  223. =cut
  224.  
  225. sub agent {
  226.     my ($self, $name) = @_;
  227.     my $old = $self->{'ua'};
  228.     if ($name) {
  229.     delete $self->{'loc'};   # all old info is now stale
  230.     $name =~ s!/?\s*\d+.\d+\s*$!!;  # loose version
  231.     $self->{'ua'}=$name;
  232.     }
  233.     $old;
  234. }
  235.  
  236. sub visit {
  237.     my($self, $netloc, $time) = @_;
  238.     $time ||= time;
  239.     $self->{'loc'}{$netloc}{'last'} = $time;
  240.     my $count = \$self->{'loc'}{$netloc}{'count'};
  241.     if (!defined $$count) {
  242.     $$count = 1;
  243.     } else {
  244.     $$count++;
  245.     }
  246. }
  247.  
  248. sub no_visits {
  249.     my ($self, $netloc) = @_;
  250.     $self->{'loc'}{$netloc}{'count'};
  251. }
  252.  
  253. sub last_visit {
  254.     my ($self, $netloc) = @_;
  255.     $self->{'loc'}{$netloc}{'last'};
  256. }
  257.  
  258. sub fresh_until {
  259.     my ($self, $netloc, $fresh_until) = @_;
  260.     my $old = $self->{'loc'}{$netloc}{'fresh'};
  261.     if (defined $fresh_until) {
  262.     $self->{'loc'}{$netloc}{'fresh'} = $fresh_until;
  263.     }
  264.     $old;
  265. }
  266.  
  267. sub push_rules {
  268.     my($self, $netloc, @rules) = @_;
  269.     push (@{$self->{'loc'}{$netloc}{'rules'}}, @rules);
  270. }
  271.  
  272. sub clear_rules {
  273.     my($self, $netloc) = @_;
  274.     delete $self->{'loc'}{$netloc}{'rules'};
  275. }
  276.  
  277. sub rules {
  278.     my($self, $netloc) = @_;
  279.     if (defined $self->{'loc'}{$netloc}{'rules'}) {
  280.     return @{$self->{'loc'}{$netloc}{'rules'}};
  281.     } else {
  282.     return ();
  283.     }
  284. }
  285.  
  286. sub dump
  287. {
  288.     my $self = shift;
  289.     for (keys %$self) {
  290.     next if $_ eq 'loc';
  291.     print "$_ = $self->{$_}\n";
  292.     }
  293.     for (keys %{$self->{'loc'}}) {
  294.     my @rules = $self->rules($_);
  295.     print "$_: ", join("; ", @rules), "\n";
  296.     }
  297. }
  298.  
  299. 1;
  300.  
  301. __END__
  302.  
  303. =back
  304.  
  305. =head1 ROBOTS.TXT
  306.  
  307. The format and semantics of the "/robots.txt" file are as follows
  308. (this is an edited abstract of
  309. <http://info.webcrawler.com/mak/projects/robots/norobots.html>):
  310.  
  311. The file consists of one or more records separated by one or more
  312. blank lines. Each record contains lines of the form
  313.  
  314.   <field-name>: <value>
  315.  
  316. The field name is case insensitive.  Text after the '#' character on a
  317. line is ignored during parsing.  This is used for comments.  The
  318. following <field-names> can be used:
  319.  
  320. =over 3
  321.  
  322. =item User-Agent
  323.  
  324. The value of this field is the name of the robot the record is
  325. describing access policy for.  If more than one I<User-Agent> field is
  326. present the record describes an identical access policy for more than
  327. one robot. At least one field needs to be present per record.  If the
  328. value is '*', the record describes the default access policy for any
  329. robot that has not not matched any of the other records.
  330.  
  331. =item Disallow
  332.  
  333. The value of this field specifies a partial URL that is not to be
  334. visited. This can be a full path, or a partial path; any URL that
  335. starts with this value will not be retrieved
  336.  
  337. =back
  338.  
  339. =head1 ROBOTS.TXT EXAMPLES
  340.  
  341. The following example "/robots.txt" file specifies that no robots
  342. should visit any URL starting with "/cyberworld/map/" or "/tmp/":
  343.  
  344.   User-agent: *
  345.   Disallow: /cyberworld/map/ # This is an infinite virtual URL space
  346.   Disallow: /tmp/ # these will soon disappear
  347.  
  348. This example "/robots.txt" file specifies that no robots should visit
  349. any URL starting with "/cyberworld/map/", except the robot called
  350. "cybermapper":
  351.  
  352.   User-agent: *
  353.   Disallow: /cyberworld/map/ # This is an infinite virtual URL space
  354.  
  355.   # Cybermapper knows where to go.
  356.   User-agent: cybermapper
  357.   Disallow:
  358.  
  359. This example indicates that no robots should visit this site further:
  360.  
  361.   # go away
  362.   User-agent: *
  363.   Disallow: /
  364.  
  365. =head1 SEE ALSO
  366.  
  367. L<LWP::RobotUA>, L<WWW::RobotRules::AnyDBM_File>
  368.  
  369. =cut
  370.